home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
BUSINESS
/
SALE24.ARJ
/
PRINEX4.PRG
< prev
next >
Wrap
Text File
|
1992-04-21
|
2KB
|
94 lines
// Prinex4.prg
#include "Setcurs.ch"
#define BAR_LIMIT 1 // Limit on # of elems in scroll bar
#define BAR_CURRENT 2 // Number of positions marked so far
#define BAR_SAVE_SCREEN 3 // Screen area overwritten
#define BAR_SAVE_CURSOR 4 // Old cursor shape
#define BAR_ELEMS_POS 5 // Elements per position
#define BAR_CUR_NUM_ELEMS 6 // Number of positions displayed
// so far
#define BAR_TOP 20
#define BAR_LEFT 10
#define BAR_BOTTOM 22
#define BAR_RIGHT 70
#define BAR_NUM_ELEMS ((BAR_RIGHT - 1) - (BAR_LEFT + 1) + 1)
FUNCTION Test
LOCAL aBar
FIELD Lname IN Tbdbf1
CLEAR SCREEN
// Sample call
USE TbDbf1
aBar := BarNew(RecCount())
// Note - to avoid calling the function so frequently, include
// a test such as iif(recno() % 10 = 0, BarMark(...), "")
// as the second expression inside the block
dbCreateIndex( "x", "Upper(Lname)", ;
{|| Upper(Lname) + BarMark(aBar, Recno())})
BarEnd(aBar)
RETURN NIL
// Call before start to get a bar "object"
FUNCTION BarNew(nRecs)
LOCAL aBar := {nRecs, 0, ;
SaveScreen(BAR_TOP, BAR_LEFT, BAR_BOTTOM, BAR_RIGHT), ;
SetCursor(SC_NONE), NIL, NIL}
aBar[BAR_ELEMS_POS] := Int(nRecs / BAR_NUM_ELEMS)
IF aBar[BAR_ELEMS_POS] < (nRecs / BAR_NUM_ELEMS)
aBar[BAR_ELEMS_POS]++
ENDIF
aBar[BAR_CUR_NUM_ELEMS] := 0
@ BAR_TOP, BAR_LEFT CLEAR TO BAR_BOTTOM, BAR_RIGHT
@ BAR_TOP, BAR_LEFT TO BAR_BOTTOM, BAR_RIGHT
RETURN aBar
// Call to mark a new position in the bar "object"
FUNCTION BarMark(aBar, nRecno)
LOCAL nPos := Int(nRecNo / aBar[BAR_ELEMS_POS])
LOCAL nDisp := nPos - aBar[BAR_CUR_NUM_ELEMS]
IF !Eof()
@ BAR_TOP + 1, BAR_LEFT + 1 + aBar[BAR_CUR_NUM_ELEMS] ;
SAY Replicate(Chr(254), nDisp)
aBar[BAR_CUR_NUM_ELEMS] := nPos
ENDIF
RETURN ""
// Call after finished to complete the bar "object" and
// restore the screen
FUNCTION BarEnd(aBar)
@ BAR_TOP + 1, BAR_LEFT + 1 SAY Replicate(Chr(254), ;
BAR_NUM_ELEMS)
// Let them see the entire bar for an instant ...
InKey(.1)
RestScreen(BAR_TOP, BAR_LEFT, ;
BAR_BOTTOM, BAR_RIGHT, ;
aBar[BAR_SAVE_SCREEN])
SetCursor(aBar[BAR_SAVE_CURSOR])
RETURN NIL